perm filename DRAW.OLD[DRW,LCS] blob sn#449474 filedate 1979-06-10 generic text, type T, neo UTF8
00100	C***** FOLLOWING IS FILE 'DRAW.CMD' **********
00200	C***	DRAW[DRW,LCS],MSSIO[NEW,LCS],CB[DRW,LCS]
00300	C***	,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
00400	C***	,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]
00500	
00600	C  'G' OR <CR> = GET.  'A'=ADD TO COMBINED FILE.
00700	C PC=PLOT  PX=XGP(→PLOT.BIN)  PXS,PCS=PLOT SMOOTHED CONTURE
00800	C  PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
00900	C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
01000	C  F=JUMP AND BEGIN FILL SECTION.  FX=EXIT AND FILL ALL.
01100	C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
01200	C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
01300		COMMON /RC/MCLEF(400),IST(4000)
01400		COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
01500		COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
01600		COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
01700		DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
01800		COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
01900		COMMON/LETS/LETS(12)
02000		EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
02100		1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
02200		1 ,(NMLST,IST(1510)),(JST,IST(500))
02300		1,(LETS(1),LG),(LETS(2),LS),(LETS(3),LM),(LETS(4),LD)
02400		1,(LETS(5),LR),(LETS(6),LP),(LETS(7),LA),(LETS(8),LF)
02500		1,(LETS(9),LE),(LETS(10),LZ),(LETS(11),LQ),(LETS(12),LC)
02600		DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
02700		1'Q','C'/
02800		DATA RJB/-20./,CENTR/-26./
02900		RSZ=0
03000	39	MCLEF(1)=0
03100		MM=0
03200		IPLT=0
03300		IPLTX=-1
03400		K=1
03500	91	TYPE 100
03600	55	FORMAT(I,2F)
03700	50	FORMAT(3A1)
03800		XSZ=RSZ
03900		ACCEPT 55,J,RSZ,GRID
04000		IF(RSZ.EQ.0)RSZ=XSZ
04100		MORE=-1
04200		REREAD 50,N,JC,JS
04300		IF(RSZ.EQ.0)RSZ=9.0
04400		IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
04500		DO 191 K=1,12       
04600	C                             G  S  M  D  R  P  A  F  E  Z
04700	191	IF(LETS(K).EQ.N)GO TO(30,30,32,33,32,30,36,79,38,39,
04800		1 56)K
04900	C         Q
05000		IF(N.NE.' ')TYPE 391
05100		GO TO 50
05200	391	FORMAT(' UNKNOWN COMMAND'/)
05300	C PXS,PCS=SMOOTH ONLY;  PXZ,PCZ=SMOOTH AND FILL
05400	C  TO SAVE SIZE FACTOR WHEN REDRAWING.
05500	1	IF(N.EQ.'V')CALL CNVT
05600	C  V=CONVERT FROM OLD FORMAT TO NEW.
05700	C  FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
05800	C  FILLS IT.
05900	C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
06000	
06100	33	IF(JS.NE.'L')GO TO 38
06200		N='Z'
06300	C  DEL=DELETE FROM COMB. FILE.   (JS='L')
06400		GO TO 36
06500	38	KED=N
06600		MM=MCLEF(1)
06700		IF(MM.NE.0)GO TO 92
06800	C  ADD TO DRAWING?
06900		GO TO 3
07000	
07100	56	CALL POG2
07200		CALL RDRAW(2,MCLEF(1),MCLEF)
07300		CALL DPYOUT(2)
07400		CALL POG1
07500		GO TO 91
07600	36 	CALL CMBN
07700	CCC	GO TO 111
07750		GO TO 91
07800	32 	CALL SHIFT(MCLEF(2),MCLEF(1),N)
07900		J=1
08000		JC=0
08100		GO TO 333
08200	291	FORMAT(A2,A5)
08300	30 	REREAD 291,NM,NM
08400		IF(JC.EQ.LM)NM=' '
08500		IF(NM.NE.' ')GO TO 293
08600	130	TYPE 41
08700		IF(JC.EQ.'M')GO TO 194
08800		IF(N.EQ.'S')GO TO 194
08900		MCLEF(1)=0
09000		MM=0
09100		IPLTX=-1
09200		K=1
09300	194	IF(JC.EQ.'M')MORE=0
09400		JQ=JC
09500		JC=0
09600		JM=1
09700		IF(MCLEF(1).EQ.0)GO TO 193
09800		JM=MCLEF(1)+1
09900	193	ACCEPT 10,NM,PASS
10000		IF(NM.EQ.' ')NM=LASTNM
10100		IF(NM.EQ.' ')GO TO 91
10200		IF(NM.EQ.'B'.OR.NM.EQ.'99')GO TO 91
10300	C  'B' OR '99'  WILL BACKUP
10400	293	IF(N.NE.'S')LASTNM=NM
10500		IF(N.EQ.'S')GO TO 40
10600		IF(LOOKF(NM).EQ.0)GO TO  130
10700	C  'FAIL' ROUTINE TO CHECK ON LOOKUP
10800		CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
10900	C  -1=READ
11000	C  CAN'T USE 'GM' WITH 'COMBINED' FILE.
11100		J=1
11200		IF(KCLEF(2).EQ.0)GO TO 290
11300		TYPE 1100
11400		ACCEPT 55,J
11500		J=J+1
11600	C  ITEMS ARE NUMBERED  0 THROUGH 9 (10 ITEMS).
11700		IF(J.GT.10)GO TO 191
11800	290	IC=KCLEF(J)+JST(KCLEF(J))-1
11900	CCC	TYPE 110,IC
12000		IF(IC.GT.350)TYPE 1110
12100	60	JZ=1
12200		IF(MORE.EQ.0)JZ=JM
12300		L=KCLEF(J)-1
12400		M=JST(L+1)+JZ-1
12500		IF(MORE.NE.0)GO TO 161
12600		M=M-1
12700		L=L+1
12800	161	DO 61 K=JZ,M
12900		L=L+1
13000	61	MCLEF(K)=JST(L)
13100		MCLEF(1)=M
13200	1100	FORMAT(' ITEM NUM?'/)
13300	700	FORMAT(' RESET X-Y POS. ',$)
13400	555	FORMAT(2F)
13500	7	IF(MORE)GO TO 70
13600		DO 771 K=2,JM-1
13700	771	IF(MCLEF(K).GE.200000000)GO TO 772
13800		GO TO 70
13900	C PUTS FILLER TO END
14000	C  MOVES OUTLINE UP FRONT
14100	772	M=MCLEF(1)
14200		DO 773 L=K,JM
14300		M=M+1
14400	773	MCLEF(M)=MCLEF(L)
14500		K=JM-K  
14600	1774	DO 774 L=JM,M
14700	774	MCLEF(L-K)=MCLEF(L)
14800		GO TO 3
14900	
15000	70	IF(N.NE.'P')GO TO 3
15100		IXRX=-1
15200		IF(JQ.NE.'X')IXRX=0
15300	C 0=SEND IT TO CALCOMP
15400		TYPE 700
15500		ACCEPT 555,X,Y
15600		IF(X.NE.0)RJB=X/RSZ
15700		IF(Y.NE.0)CENTR=Y/RSZ
15800	C  TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
15900		IF(IPLTX)CALL PLOTS(0)
16000	C  DO I NEED THIS?
16100		IF(GRID.GT.0)CALL GRIDS
16200		IPLTX=0
16300		IPLT=-1
16400	3	IF(N.NE.'D')MM=0
16500	C  RESET IF NOT GOING TO DRAWIT
16600	333	IF(N.EQ.'P')GO TO 337
16700		CALL DPYSET(1,IST,4000)
16800		CALL DPYBRT(4)
16900		NIST=IST(2)
17000		IF(N.GE.0)GO TO 337
17100		IF(N.EQ.'G')GO TO 337
17200		IF(N.EQ.'M')GO TO 337
17300		IF(N.NE.'R')GO TO 92
17400	337	IF(JS.EQ.'Z')GO TO 306
17500		IF(JS.NE.'S')GO TO 338
17600		CALL SMOOTH(JS)
17700		GO TO 436
17800	338	IC=-1
17900		MM=1
18000		DO 335 K=2,MCLEF(1)
18100		IF(MCLEF(K).LT.200000000)GO TO 335
18200		IC=K
18300		GO TO 334
18400	C FOR 1ST LOC. OF MCLEF IN FILLER
18500	335	CONTINUE
18600	334	CALL RDRAW(2,MCLEF(1),MCLEF)
18700		CALL DPYOUT(1)
18800		NIST=IST(2)
18900		GO TO 436
19000	C NO FILLER
19100	79	IF(IC)GO TO 91
19200	C  IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
19300		JZ=N
19400		KK=0
19500		IF(JC.NE.'S')GO TO 206
19600	C  TYPE 'FS' TO FILL AND SMOOTH
19700	306	CALL SMOOTH(0)
19800	C  SMOOTHS AND FILLS
19900		GO TO 436
20000	206	RR=RSZ
20100		DO 205 J=IC,MCLEF(1)
20200		CALL UNPACK(J,M,N,MCLEF)
20300		KK=KK+1
20400		NF(KK)=0
20500		IF(LL.GE.100000000)NF(KK)=3
20600		QF(KK)=(M+RJB)*RR
20700	205	RF(KK)=(N+CENTR)*RR
20800		NF(1)=KK
20900		CALL FILLQ(QF,RF,NF)
21000	436	IF(JZ.EQ.'P')CALL PLOT(0,0,3)
21100		GO TO 91
21200	
21300	66	TYPE 666,NM
21400		GO TO 91
21500	666	FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
21600	336	FORMAT(' SMOOTH? ',$)
21700	10	FORMAT(A5,F)
21800	5	FORMAT(12I)
21900	100   FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/'
22000		1 P=PLOT, PX=XGP, A=ADD TO SAVED FILE
22100		1, DEL=DEL. FROM FILE, Q=BACKGROUND, Z=ZERO DRAWING'/
22200		1' F=FILL,  E=EDIT,   N1=SIZE, N2=1=GRID '/)
22300	C  N1=20 TO CHANGE SHAPE
22400	
22500	92	IST(2)=NIST
22600		CALL DRAWIT
22700	  	N=0
22800		GO TO 3
22900	
23000	403	FORMAT(' WRITE OVER ',A5,'.DMD?  ',$)
23100	41	FORMAT(' TYPE FILE NAME'/)
23200	C  SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
23300	40	IF(LOOKF(NM).EQ.0)GO TO 402
23400		TYPE 403,NM
23500		ACCEPT 50,K
23600		IF(K.EQ.'N')GO TO 191
23700	402	NMLST(1)=NM
23800		JCLEF(1)=1
23900		DO 1111 K=2,10
24000		JCLEF(K)=0
24100	1111	NMLST(K)=' '
24200		CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
24300		NQ=MCLEF(1)
24400	CC111	TYPE 110,NQ
24500		IF(NQ.GT.350)TYPE 1110
24600		GO TO 91
24700	CC120	FORMAT(' 9999  1 ',I4,' 0 0 0 0 0 0 0 0')
24800	110	FORMAT(' TOTAL WDS=',I3)
24900	1110	FORMAT(' ********************************',/
25000		1      ' ***** WARNING - LIMIT=350 ******',/
25100		1      ' ********************************')
25200		END